home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / xini.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-01-16  |  9.6 KB  |  358 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (*        filename        : XINI.PAS                                         *)
  4. (*        author          : Max Maischein  /       FidoNet :  2:249/6.17     *)
  5. (*        adapted         : Stefan Boether / Compuserve Id : 100023,275      *)
  6. (*                                                 FidoNet :  2:243/91.331   *)
  7. (*                                  Internet: 100023.275@CompuServe.COM      *)
  8. (*        system          : BP 7.0                                           *)
  9. (*        changes         :                                                  *)
  10. (*        when    what                                                who    *)
  11. (*---------------------------------------------------------------------------*)
  12. (*       16.01.93 Use the PChar-Type came with BP 7.0 also for DOS    Stefc  *)
  13. (*****************************************************************************)
  14. (*  Description :  An object for handling *.INI files !                      *)
  15. (*****************************************************************************)
  16. {Header-End}
  17. (*
  18.    Notification :  The most of the work came from Max !! Many thanks
  19.                    to him from me. I adapated it to my Xlibary's for
  20.                    my own suppose, so if you want the original
  21.                    unit please contact Max not me ! In his original
  22.                    unit there also is a little more flexible than
  23.                    my version. But my is smaller because many of
  24.                    the function he has in his, I've in my own libs !
  25.                    And I have use the IScan function from the
  26.                    EDITORS Unit here, so it may be some faster !
  27.                    If you find some bugs in this source, please
  28.                    let me know ?
  29.  
  30.                                        - Mfg Stefc -
  31.  
  32. *)
  33.  
  34. UNIT   xIni; {$O+,D+,I-}
  35.  
  36. INTERFACE
  37.  
  38. USES   Dos,
  39.        Objects,
  40.        Strings;
  41.  
  42. TYPE   PProfile= ^TProfile;
  43.        TProfile= object( TObject )
  44.          constructor Init( FileName: PathStr; AGroup: String );
  45.          destructor  Done; virtual;
  46.          function    GetString  ( ItemName:String; Default:String) : String;
  47.          procedure   WriteString( ItemName:String; Value  :String );
  48.          function    GetInt     ( ItemName:String; Default:Integer):Integer;
  49.          procedure   WriteInt   ( ItemName:String; Value  :Integer);
  50.        private
  51.          Changed    : Boolean;
  52.          TheBuffer  : PChar;
  53.          TheFile    : file;
  54.  
  55.          Group      : String;
  56.          GroupStart : PChar;
  57.          GroupSize  : Word;
  58.  
  59.          Function  SetGroup( NewGroup : String ) : Boolean;
  60.          Procedure CreateGroup( NewGroup : String );
  61.        End;
  62.  
  63. IMPLEMENTATION
  64.  
  65. const  cr   = #$0D;
  66.        lf   = #$0A;
  67.        crlf = cr+lf;
  68.  
  69. { Thanks to Borland for their fast string search asm procs ! }
  70. const sfSearchFailed = $FFFF;
  71.  
  72. function IScan(var Block; Size: Word; Str: String): Word; assembler;
  73.  var S: String;
  74. asm
  75.     PUSH    DS
  76.     MOV    AX,SS
  77.     MOV    ES,AX
  78.     LEA    DI,S
  79.     LDS    SI,Str
  80.     XOR    AH,AH
  81.     LODSB
  82.     STOSB
  83.     MOV    CX,AX
  84.     MOV    BX,AX
  85.     JCXZ    @@9
  86. @@1:    LODSB
  87.     CMP    AL,'a'
  88.     JB    @@2
  89.     CMP    AL,'z'
  90.     JA    @@2
  91.     SUB    AL,20H
  92. @@2:    STOSB
  93.     LOOP    @@1
  94.     SUB    DI,BX
  95.     LDS    SI,Block
  96.     MOV    CX,Size
  97.     JCXZ    @@8
  98.     CLD
  99.     SUB    CX,BX
  100.     JB    @@8
  101.     INC    CX
  102. @@4:    MOV    AH,ES:[DI]
  103.     AND    AH,$DF
  104. @@5:    LODSB
  105.     AND    AL,$DF
  106.     CMP    AL,AH
  107.     LOOPNE    @@5
  108.     JNE    @@8
  109.     DEC    SI
  110.     MOV    DX,CX
  111.         MOV    CX,BX
  112. @@6:    REPE    CMPSB
  113.     JE    @@10
  114.     MOV    AL,DS:[SI-1]
  115.     CMP    AL,'a'
  116.     JB    @@7
  117.     CMP    AL,'z'
  118.     JA    @@7
  119.     SUB    AL,20H
  120. @@7:    CMP    AL,ES:[DI-1]
  121.     JE    @@6
  122.     SUB    CX,BX
  123.     ADD    SI,CX
  124.     ADD    DI,CX
  125.     INC    SI
  126.     MOV    CX,DX
  127.         OR      CX,CX
  128.     JNE    @@4
  129. @@8:    XOR    AX,AX
  130.     JMP    @@11
  131. @@9:    MOV    AX, 1
  132.     JMP    @@11
  133. @@10:    SUB    SI,BX
  134.     MOV    AX,SI
  135.     SUB    AX,WORD PTR Block
  136.     INC    AX
  137. @@11:    DEC    AX
  138.     POP    DS
  139. end;
  140.  
  141. {  - Thanks to Freddy Ertl and Ralph Machholz for the following two procs ! }
  142. function Str2PChar(var St:String):PChar;
  143.   var i : Integer;
  144. begin
  145.   i := Length(St);
  146.   Move( St[1], St[0], I );
  147.   St[i] := #0;
  148.   Str2PChar := PChar(@St);
  149. end;
  150.  
  151. function PChar2Str(var St:String):String;
  152.   var i : Integer;
  153. begin
  154.   i := 0 ;
  155.   while (St[i] <> #0) do inc(i);
  156.   If i > 254 then RunError(255);
  157.   Move(St[0],St[1],I);
  158.   St[0]:=Chr(i);
  159.   PChar2Str := St;
  160. end;
  161.  
  162. { - Some stuff came from me ! }
  163. function UpCaseStr( St:String):string;
  164.   var I : BYTE;
  165. begin
  166.   for I := 1 TO LENGTH( St ) DO
  167.     St[I] := UpCase( St[i] );
  168.   UpCaseStr := St;
  169. END;
  170.  
  171. procedure CheckGroup(var NewGroup:String);
  172. begin
  173.   If NewGroup[ 1 ] <> '[' then
  174.      NewGroup := '[' + NewGroup;
  175.   If NewGroup[Length(NewGroup)] <> ']' then
  176.      NewGroup := NewGroup + ']';
  177. end;
  178.  
  179. procedure CheckItem(var ItemName:String);
  180. begin
  181.   if ItemName[Length(ItemName)] <> '=' then
  182.      ItemName := ItemName + '=';
  183. end;
  184.  
  185. (************************************************************************)
  186.  (*                                                                      *)
  187.   (*        Object : TProFile                                             *)
  188.    (*                                                                      *)
  189.     (************************************************************************)
  190.  
  191. constructor TProfile.Init;
  192.   const fmDenyWrite  = $20;
  193.   var   TheSize : word;
  194.         SavFileMode : Word;
  195. begin
  196.   inherited Init;
  197.   If Pos( '.',FileName)= 0 then FileName := FileName + '.INI';
  198.  
  199.   SavFileMode := filemode;
  200.   filemode := fmDenyWrite;     { Other only can read the file !!! }
  201.   Assign( TheFile, FileName );
  202.   Reset ( TheFile, 1 );
  203.   if ioresult <> 0 then begin
  204.      rewrite( TheFile, 1 );
  205.      if ioresult <> 0 then
  206.         fail
  207.      else
  208.         TheSize := 0;
  209.   end else
  210.      TheSize := filesize(TheFile);
  211.   filemode := SavFilemode;
  212.  
  213.   GetMem( TheBuffer, Succ(TheSize)); { Get enough memory to hold the entire File }
  214.   BlockRead( TheFile, TheBuffer^,TheSize);
  215.   StrLCopy( TheBuffer,TheBuffer,TheSize);
  216.  
  217.   GroupSize  := 0;
  218.   GroupStart := TheBuffer;
  219.  
  220.   If not SetGroup( AGroup ) then
  221.      CreateGroup( AGroup );
  222.  
  223.   Changed := False;
  224. End;
  225.  
  226. Destructor TProfile.Done;
  227. Begin
  228.   If Changed then begin
  229.      ReWrite( TheFile, 1 );
  230.      BlockWrite( TheFile, TheBuffer^, StrLen(TheBuffer));
  231.   end;
  232.   Close( TheFile );
  233.   StrDispose(TheBuffer);
  234.   inherited Done;
  235. End;
  236.  
  237. { - Go to the specific group }
  238. Function TProfile.SetGroup;
  239.   Var MyPos  : Word;
  240.       P      : PChar;
  241. Begin
  242.   If NewGroup = '' then Begin
  243.      GroupStart := TheBuffer;
  244.      GroupSize  := StrLen(TheBuffer);
  245.      SetGroup   := True;
  246.      Exit; { could be better, but ;-) }
  247.   End;
  248.  
  249.   CheckGroup(NewGroup);
  250.   MyPos    := IScan( TheBuffer^, StrLen(TheBuffer), UpcaseStr(NewGroup));
  251.   If MyPos <> sfSearchFailed then Begin
  252.      GroupStart := TheBuffer + MyPos;
  253.      Group      := NewGroup;
  254.      P          := StrScan( GroupStart+Length(NewGroup), '[' );
  255.      If P = nil then
  256.         GroupSize := StrLen(GroupStart)
  257.      else
  258.         GroupSize := P-GroupStart;
  259.      SetGroup := True;
  260.   End else
  261.      SetGroup := False;
  262. End;
  263.  
  264. { - Append a new group into the INI-File - }
  265. Procedure TProfile.CreateGroup;
  266.  Var NewBuffer : PChar;
  267. Begin
  268.   CheckGroup(NewGroup);
  269.   NewGroup := NewGroup + CRLF;
  270.  
  271.   GetMem  ( NewBuffer, StrLen(TheBuffer)+Length(NewGroup));
  272.   StrLCopy( NewBuffer, TheBuffer,StrLen(TheBuffer));
  273.   StrCat  ( NewBuffer, Str2PChar(NewGroup));
  274.  
  275.   StrDispose(TheBuffer);
  276.   TheBuffer := NewBuffer;
  277.   PChar2Str(NewGroup);
  278.   Delete( NewGroup, Pred(Length(NewGroup)), 2 );
  279.   SetGroup(NewGroup);
  280.   Changed := True;
  281. End;
  282.  
  283. { - Get a string-item from the group }
  284. Function TProfile.GetString;
  285. Var MyPos : Word;
  286.     P,Q   : PChar;
  287.     Tmp   : array[0..255] of char;
  288. Begin
  289.   GetString := Default;
  290.   CheckItem( ItemName );
  291.   MyPos := IScan(GroupStart^,GroupSize,UpcaseStr(ItemName));
  292.   If MyPos <> sfSearchFailed then begin
  293.      Q := GroupStart + (MyPos + Length(ItemName));
  294.      P := StrScan(Q, CR );
  295.      If P <> nil then
  296.         GetString := StrPas(StrLCopy(Tmp,Q,P-Q));
  297.   end
  298. End;
  299.  
  300. { - Write a string-item to the group }
  301. Procedure TProfile.WriteString;
  302.   Var NewBuffer : PChar;
  303.       NewString : String;
  304.       MyPos     : Word;
  305.  
  306.   procedure ResetBuffer;
  307.   begin
  308.     StrDispose(TheBuffer);
  309.     TheBuffer := NewBuffer;
  310.     SetGroup(Group);
  311.     Changed := True;
  312.   end;
  313.  
  314. Begin
  315.   CheckItem(ItemName);
  316.   If GetString(ItemName,'') <> '' then begin { remove old Item + Value }
  317.      NewString := ItemName + GetString( ItemName,'') + CRLF;
  318.      GetMem( NewBuffer, StrLen(TheBuffer)-Length(NewString));
  319.      MyPos:= IScan( GroupStart^, GroupSize, UpcaseStr(ItemName));
  320.      StrLCopy( NewBuffer, TheBuffer,(GroupStart-TheBuffer)+MyPos);
  321.      StrCat  ( NewBuffer, GroupStart + MyPos + Length(NewString));
  322.      ResetBuffer;
  323.   End;
  324.  
  325.   If Value <> '' then Begin  { add new item + value }
  326.      NewString:= ItemName + Value + CRLF;
  327.      GetMem  ( NewBuffer, StrLen(TheBuffer)+Length(NewString));
  328.      StrLCopy( NewBuffer, TheBuffer, (GroupStart-TheBuffer)+GroupSize);
  329.      StrCat  ( NewBuffer, Str2PChar( NewString ));
  330.      StrCat  ( NewBuffer, GroupStart + GroupSize );
  331.      ResetBuffer;
  332.   End;
  333. End;
  334.  
  335. {- Get am integer value from the INI-file }
  336. function TProfile.GetInt;
  337.   var St:String; V,C: Integer;
  338. begin
  339.   St:=GetString(ItemName,'');
  340.   IF St = '' then
  341.      GetInt := Default
  342.   else begin
  343.      Val(St,V,C);
  344.      IF C = 0 then GetInt := V
  345.               else GetInt := Default;
  346.   end;
  347. end;
  348.  
  349. {- Write an integer value to the INI-file }
  350. procedure TProfile.WriteInt;
  351.   var St:String[6];
  352. begin
  353.   str(Value,St);
  354.   WriteString(ItemName,St);
  355. end;
  356.  
  357. end.
  358.